home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / Macros / Cell Scoring Macros < prev    next >
Text File  |  1993-11-04  |  875b  |  56 lines
  1. {Use this set of macros to manually scoring two
  2.  types of cells. Counts are kept in two global
  3. variables and displayed in the Values window.
  4. }
  5.  
  6. var
  7.   UCount, LCount:integer; {Global variables, initially zero}
  8.  
  9.  
  10. procedure ShowCellCounts;
  11. begin
  12.   ShowMessage('U. Count: ', UCount:1,'\',
  13.     'L. Count: ',LCount:1,'\'
  14.     'Total    : ',UCount+LCount:1);
  15. end;
  16.  
  17. macro 'Reset Cell Counts';
  18. begin
  19.   UCount:=0;
  20.   LCount:=0;
  21.   ShowCellCounts;
  22. end;
  23.  
  24. procedure MarkCell(c:string);
  25. {Draws a character in the current foreground color.}
  26. var
  27.   x,y:integer;
  28. begin
  29.   SetFont('Monaco');
  30.   SetFontSize(9);
  31.   SetText('Right Justified');
  32.   GetMouse(x,y);
  33.   MoveTo(x+4,y);
  34.   Write(c);
  35. end;
  36.  
  37. macro 'Score Unlabeled Cell [1]';
  38. begin
  39.   UCount:=UCount+1;
  40.    MarkCell('*');
  41.   ShowCellCounts;
  42. end;
  43.  
  44. macro 'Score Labeled Cell [2]';
  45. begin
  46.   LCount:=LCount+1;
  47.   MarkCell('+');
  48.   ShowCellCounts;
  49. end;
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.